home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / qex / qexfq194 / freqcnt.pas < prev   
Pascal/Delphi Source File  |  1993-09-21  |  5KB  |  157 lines
  1. Pascal Source Code Listing
  2.  
  3.  
  4. {$C-,U-}
  5. program freqcnt;
  6. const baseaddr = $300;
  7. type count = array[0..6] of byte;
  8.  
  9. procedure scanclk(control:byte);
  10. var qc: byte;
  11. begin
  12.      qc := control AND $DF; {scan clock low}
  13.      port[baseaddr] := qc;
  14.      qc := control OR $20; {scan clock high}
  15.      port[baseaddr] := qc;
  16. end;
  17.  
  18. procedure getcount(control:byte; var data:count);
  19. var xc,dc,dct: byte;
  20. begin
  21.      xc := control;
  22.      dc := port[baseaddr];
  23.      data[1] := dc SHR 4;
  24.      data[0] := dc AND $0F;
  25.      dc := port[baseaddr + 1];
  26.      data[6] := dc AND $0F;
  27.      xc := xc AND $F7; {remove scan master reset}
  28.      port[baseaddr] := xc;
  29.      scanclk(xc);
  30.      dc := port[baseaddr + 1];
  31.      data[5] := dc AND $0F;
  32.      scanclk(xc);
  33.      dc := port[baseaddr + 1];
  34.      data[4] := dc AND $0F;
  35.      scanclk(xc);
  36.      dc := port[baseaddr + 1];
  37.      data[3] := dc AND $0F;
  38.      scanclk(xc);
  39.      dc := port[baseaddr + 1];
  40.      data[2] := dc AND $0F;
  41.      port[baseaddr] := control;
  42. end;
  43.  
  44. var i: integer;
  45.     d, control: byte;
  46.     data: count;
  47.     gate,prescale,lz,dsj: boolean;
  48.     freq, pp: real;
  49.     xk: char;
  50. label start;
  51.  
  52. begin
  53.      prescale := False;
  54.      gate := True;  {True => short gate}
  55.      dsj := True;
  56. start:
  57.      if KeyPressed then
  58.         begin
  59.         read(Kbd,xk);
  60.         if (xk = Char(27)) then
  61.            begin
  62.                 dsj := True;
  63.                 read(Kbd,xk);
  64.                 if (xk = Char(68)) then prescale := NOT prescale;
  65.                 if (xk = Char(59)) then gate := NOT gate;
  66.                 if (xk = Char(60)) then Halt;
  67.            end;
  68.         if (xk = 'x') then Halt;
  69.         if prescale then gate := True;
  70.         end;
  71.      control := $FF;
  72.      if gate then control := control AND $FE;
  73.      if prescale then control := control AND $FD;
  74.      port[baseaddr] := control;
  75.      control := control AND $FB;
  76.      delay(1000);
  77.      port[baseaddr] := control; {remove clear}
  78.      port[baseaddr + 3] := $80; {arm gate}
  79.      repeat
  80.      d := port[baseaddr + 2];
  81.      d := d AND $80;
  82.      until (d = $80);
  83.      repeat
  84.      d := port[baseaddr + 2];
  85.      d := d AND $80;
  86.      until (d = $0);
  87.      getcount(control,data);
  88.      if dsj then begin
  89.         ClrScr;
  90.         Writeln('                Frequency Counter');
  91.         Writeln;
  92.         Writeln('                    F1    1 Second Gate / 0.1 Second Gate');
  93.         Writeln('                    F10   Direct Input / Prescaler');
  94.         Writeln('                    x     Exit');
  95.         Writeln;
  96.         Writeln;
  97.         Writeln;
  98.         Write('                Input source: ');
  99.         if (prescale) then writeln('prescaler (50 Ohm)') else writeln('direct');
  100.         Write('                Gate: ');
  101.         if (gate) then writeln('0.1 second') else writeln('1 second');
  102.         Write('                Maximum Input Frequency: ');
  103.         if (prescale) then writeln('1 GHz') else
  104.            if (gate) then writeln('40 MHz') else writeln('9.9 MHz');
  105.         dsj := False;
  106.      end;
  107.      GotoXY(1,14);
  108.      ClrEol;
  109.      lz := False;
  110.      if (gate AND NOT prescale) then
  111.         begin
  112.         Write('                        ');
  113.         for i := 6 downto 3 do
  114.             begin
  115.                  if ((data[i] = 0) AND NOT lz) then write(' ')
  116.                     else begin
  117.                               write(data[i]);
  118.                               if (i = 5) then write(',');
  119.                               lz := True;
  120.                          end;
  121.             end;
  122.         write(data[2],'.');
  123.         for i := 1 downto 0 do write(data[i]);
  124.         writeln('      kiloHertz');
  125.         end;
  126.      if ((NOT gate) and (NOT prescale)) then
  127.         begin
  128.         Write('                        ');
  129.         for i := 6 downto 1 do
  130.             begin
  131.                  if ((data[i] = 0) AND NOT lz) then write(' ')
  132.                     else begin
  133.                               write(data[i]);
  134.                               if ((i = 6) OR (i = 3)) then write(',');
  135.                               lz := True;
  136.                          end;
  137.             end;
  138.         writeln(data[0],'      Hertz');
  139.         end;
  140.      if (prescale) then
  141.         begin
  142.         freq := 0;
  143.         pp := 1;
  144.         for i := 0 to 6 do
  145.             begin
  146.                  freq := freq + pp*data[i];
  147.                  pp := pp*10.0;
  148.             end;
  149.         freq := freq*64.0/1000000.0;
  150.         if (gate) then freq := freq*10.0;
  151.         Write('                        ');
  152.         writeln(freq:10:4,'      MegaHertz');
  153.         end;
  154.      goto start;
  155. end.
  156. 
  157.